#!/usr/bin/perl
#$Source: Volumes://MATEOR/prlserverapi/webserver.pl$
#$Revision: 0.01-0a$
#$Date: June 19, 2012$
#
#-------------
# PrlServerAPI Copyright Matthew Caswell, 2012
#-------------
#

use strict;
use Socket;
use warnings;
use serverconf;

require "www/default.pl";
use vars qw/
  %Default_pl
/;

my($SERVER) = {
  PORT => $ARGV[0],
  VERSION => '0.01-0a'
};
my($CONF) = &serverconf::getConf();
sub debug{
  my($msg) = shift;
  print "\e[32m[DEBUG: $msg ]\e[0m\n";
}

socket(SOCKET, PF_INET, SOCK_STREAM, $SERVER->{PROTOCOL})
  or die "Can't open socket!";

setsockopt(SOCKET, SOL_SOCKET, SO_REUSEADDR, 1)
  or die "Can't set socket SO_REUSEADDR.";

bind(SOCKET, pack( 'Sn4x8', AF_INET, $SERVER->{PORT}, "\0\0\0\0" ))
  or die "Can't bind to port $SERVER->{PORT}\n";

listen(SOCKET, 5)
  or die "listen: $!\nPrlServerAPI server \e[1;31mfailed to start\e[0m on port \e[0;35m$SERVER->{PORT}\e[0m\n";

sub Request{
  my($this, $r) = @_;
  my @stream = split(/ /, $r);
  $this->{method} = $stream[0];
  $this->{uri}->{full} = $stream[1];
  $this->{proto} = $stream[2];
  if($this->{uri}->{full} =~ m/\?/){
    my @uri = split(/\?/, $this->{uri}->{full});
    $this->{uri}->{path} = $uri[0];
    $this->{uri}->{param} = $uri[1];
    if($this->{uri}->{param} =~ m/\&/){
      my @params = split(/\&/, $this->{uri}->{param});
      my $i;
      for($i = 0; $params[$i]; $i++){
        if($params[$i] =~ m/\=/){
          my @stat = split(/\=/, $params[$i]);
          $this->{uri}->{params}->{$stat[0]} = $stat[1];
          &debug("URI->PARAMS->$stat[0] => $stat[1]");
        } else {
          &debug("URI->PARAMS->$params[$i] = 1");
          $this->{uri}->{params}->{$params[$i]} = 1;
        }
      }
    } else {
      if($this->{uri}->{param} =~ m/\=/){
        my @stat = split(/\=/, $this->{uri}->{param});
        $this->{uri}->{params}->{$stat[0]} = $stat[1];
        &debug("URI->PARAMS->$stat[0] => $stat[1]");
      } else {
        &debug("URI->PARAMS->$this->{uri}->{param} = 1");
        $this->{uri}->{params}->{$this->{uri}->{param}} = 1;
      }
    }
  } else {
    $this->{uri}->{path} = $this->{uri}->{full};
    $this->{uri}->{param} = 1;
    $this->{uri}->{params}->{0} = 1;
    &debug("URI->PARAMS->0 = 1");
  }
  
  return $this;
}
my($client);
my($in);
my($request);
my($string);
while(1){
  $client = accept(NET_SOCKET, SOCKET);
  $in = <NET_SOCKET>;
  &debug("<NET_SOCKET> => $in");
  $request = &Request($request, $in);
  &debug("METHOD => $request->{method}");
  &debug( "URI => $request->{uri}->{full}");
  &debug( "URI->PATH => $request->{uri}->{path}");
  &debug( "URI->PARAM => $request->{uri}->{param}");
  &debug( "PROTO => $request->{proto}");

  if($request->{uri}->{path} eq $CONF->{INDEX_PATH}){
    print NET_SOCKET "HTTP/1.0 200 OK\nContent-Type: text/html\n\n";
    {
      local $/=undef;
      open INDEX, "<./www/$CONF->{INDEX_PATH}"
        or &debug("Couldn't open $CONF->{INDEX_PATH}");
      binmode INDEX;
      $string = <INDEX>;
      close INDEX;
    }
    &debug($string);
    print NET_SOCKET $string;
  } elsif($request->{uri}->{path} eq "/" and $CONF->{DEFAULT_REDIRECT} eq 'TRUE') {
    print NET_SOCKET "HTTP/1.0 200 OK\nContent-Type: text/html\n\n";
    &debug($Default_pl{'content'}->($request, $SERVER->{PORT}, $CONF->{HOSTNAME}, $CONF->{DEFAULT_REDIRECT}, $CONF->{INDEX_PATH}));
    print NET_SOCKET $Default_pl{'content'}->($request, $SERVER->{PORT}, $CONF->{HOSTNAME}, $CONF->{DEFAULT_REDIRECT}, $CONF->{INDEX_PATH});
  } elsif($request->{uri}->{path} eq "/default.pl") {
    print NET_SOCKET "HTTP/1.0 200 OK\nContent-Type: text/html\n\n";
    &debug($Default_pl{'content'}->($request, $SERVER->{PORT}, $CONF->{HOSTNAME}, $CONF->{DEFAULT_REDIRECT}, $CONF->{INDEX_PATH}));
    print NET_SOCKET $Default_pl{'content'}->($request, $SERVER->{PORT}, $CONF->{HOSTNAME}, $CONF->{DEFAULT_REDIRECT}, $CONF->{INDEX_PATH});
  } else {
    print NET_SOCKET "HTTP/1.0 200 OK\nContent-Type: text/html\n\n";
    {
      local $/=undef;
      open INDEX, "<./www/$request->{uri}->{path}"
        or print NET_SOCKET "Couldn't open $request->{uri}->{path}";
      binmode INDEX;
      $string = <INDEX>;
      close INDEX;
    }
    &debug($string);
    print NET_SOCKET $string;
  }

  close NET_SOCKET;
  undef $request;
}
